perm filename CMPARE[CRE,BGB] blob
sn#106831 filedate 1974-06-18 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00022 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE CMPARE - COMPARE IMAGES - BGB - APRIL 1973.
C00006 00003 SUBR(CMCNII)IMG1,IMG2 I. COMPARE & CONNECT IMAGE IMAGE.
C00008 00004 SUBR(CMCNLL)LEV1,LEV2 I. COMPARE & CONNECT LEVEL LEVEL.
C00010 00005 SUBR(CMCNPP)L1,L2 I. COMPARE & CONNECT POLYGONS POLYGONS.
C00012 00006 SUBR(CMCNSP)SL,PL,FLG I. COMPARE & CONNECT SHAPES POLYGONS.
C00014 00007 SUBR(MKSHAP)LEVEL II. MAKE PGN SHAPE NODES FOR A LEVEL.
C00015 00008 SUBR(MKLINT)PGN MAKE LAMINA INERTIA TENSOR OF A POLYGON.
C00020 00009 SUBR(FUSION)S1,S2 II. MAKE A FUSION SHAPE NODE.
C00023 00010 SUBR(MKFURN)LEVEL,FLG II. MAKE FUSION RING OF A LEVEL.
C00025 00011 SUBR(KLFURN)LEVEL,FLG II. KILL FUSION RING OF A LEVEL.
C00026 00012 SUBR(CMPARE)S1,S2 III. COMPARE SHAPE SHAPE PASS FAIL.
C00028 00013 SUBR(CNNECT)S1,S2 III. CONNECT SHAPE SHAPE.
C00031 00014 SUBR(CMCNVV)P1,P2 IV. COMPARE AND CONNECT VERTICES.
C00034 00015 SUBR(SPLIT)WINDOW IV. WINDOW SPLIT.
C00038 00016 SUBR(MATE1)WINDOW IV. MATE VERTICES IN WINDOW.
C00039 00017 SUBR(MATE2)PTR1,PTR2 IV. FIND VERTEX MATES PTR1 PTR2.
C00041 00018 SUBR(SQRT)X TRIG: SQUARE ROOT. AC-TRANSPARENT.
C00043 00019 SUBRS: SINCOS TRIG: SINE AND COSINE ROUTINES.
C00045 00020 SUBR(ATAN2)YYY,XXX TRIG: ARC TANGENT ROUTINE.
C00047 00021 SUBR(ACOS)X TRIG: ARC COSINE, ARC SINE ROUTINES.
C00049 00022 SUBR(ATAN)X TRIG: ARC TANGENT ROUTINE.
C00052 ENDMK
C⊗;
TITLE CMPARE - COMPARE IMAGES - BGB - APRIL 1973.
.INSERT MNCRE
EXTERN AV,AI,DPYSET,DPYBUF,DPYOUT,GETXY,AIVECT,DTYO
EXTERN MKNODE,KLNODE
EXTERN ECOMP ;ENABLE COMPARE AND ATTACH ROUTINES.
;VERTEX COMPARE WINDOW.
EPSILN: 6⊗6 ;SHAPE CENTER OF MASS DELTA MATCH.
EPSLN2: 36⊗=12 ;VERTEX LOCUS DELTA MATCH.
↓LINK ←←0 ;POINTER TO PREVIOUS WINDOW.
↓RMIN ←←1
↓RMAX ←←2
↓CMIN ←←3
↓CMAX ←←4
↓FLAG ←←5 ;0 FOR ROW. -1 FOR COL.
↓M ←←6 ;NUMBER OF POLYGON-1 VERTICES.
↓N ←←7 ;NUMBER OF POLYGON-2 VERTICES.
;SHAPE NODE LINK NAMES.
DEFINE PERM.(A,Q){HLLM A,1(Q)} ↔ DEFINE PERM(A,Q){HLLE A,1(Q)}
DEFINE AREA.(A,Q){HLRM A,1(Q)} ↔ DEFINE AREA(A,Q){HRLE A,1(Q)}
DEFINE PXY. (A,Q){HLLM A,4(Q)} ↔ DEFINE PXY (A,Q){HLLE A,4(Q)}
DEFINE MZZ. (A,Q){HLRM A,4(Q)} ↔ DEFINE MZZ (A,Q){HRLE A,4(Q)}
DEFINE MXX. (A,Q){HLLM A,6(Q)} ↔ DEFINE MXX (A,Q){HLLE A,6(Q)}
DEFINE MYY. (A,Q){HLRM A,6(Q)} ↔ DEFINE MYY (A,Q){HRLE A,6(Q)}
;COMPARE QUALIFING QUANTIES:
INTERN QQCNTR,QQPRAX,QQMZZ,QQAREA,QQPERM
QQCNTR: 8.0
QQPRAX: 0
QQMZZ: 0.06 ;SIX PER CENT.
QQAREA: 0
QQPERM: 0
;ULTRA-FUNCTIONAL DATA TRANSMISSIONS.
DECLARE{ROWDEL,COLDEL} ;PASS SHAPE ALLIGNMENT FROM CMPARE TO CMCNVV.
SUBR(CMCNII)IMG1,IMG2 ;I. COMPARE & CONNECT IMAGE IMAGE.
BEGIN CMCNII;------------------------------------------------------------------
COMMENT ⊗
Main outer loop. CMCNII compares the polygons of two images and
connects polygons and vertices that correspond. CMCNII itself is merely a MAPC
thru the level rings of the two images. ⊗
;INITIAL LEVELS OF THE IMAGES.
LAC 1,ARG2 ;IMAGE 1.
LAC 2,ARG1 ;IMAGE 2.
CAMN 1,2↔POP2J ;DON'T CONNECT AN IMAGE TO ITSELF.
SON 1,1↔SON 2,2 ;FIRST LEVELS OF THESE IMAGES.
DAC 1,LEV0#
;RING AROUND THE LEVELS OF EACH IMAGE.
L1: DAC 1,LEV1#↔DAC 2,LEV2#
CALL(CMCNLL,LEV1,LEV2)
LAC 1,LEV1↔CCW 1,1
LAC 2,LEV2↔CCW 2,2
CAME 1,LEV0↔GO L1
;CLEAR DIAGONOSTIC GLASS 5 AND 14.
SETZB 0,1↔UPGIOT 14,0↔UPGIOT 5,0
POP2J
BEND CMCNII; BGB 13 APRIL 1973 ------------------------------------------------
SUBR(CMCNLL)LEV1,LEV2 ;I. COMPARE & CONNECT LEVEL LEVEL.
BEGIN CMCNLL;------------------------------------------------------------------
COMMENT ⊗ Make polygon shapes for the current level. Compare all the polygon
shapes of the previous level with all the polygon shapes of the current level
and connect polygons on exact compare true. Then make fusion shape ring of
previous level's p-unmated polygons and compare with the n-unmated polygons of
the current level and connect polygons two to one on compare true. Then make
fusion shape ring of current level's n-unmated polygons and compare with the
p-unmated polygons of the previous level. ⊗
LAC ARG2↔DAC LEVEL1
LAC ARG1↔DAC LEVEL2
CALL(MKSHAP,LEVEL1) ;NOP IF SHAPES ALREADY EXIST.
CALL(MKSHAP,LEVEL2)
CALL(CMCNPP,LEVEL1,LEVEL2) ;FOR EXACT MATCHS.
CALL(MKFURN,LEVEL1,[0])
CALL(CMCNSP,LEVEL1,LEVEL2,[0]) ;FOR FUSION MATCHS.
CALL(KLFURN,LEVEL1)
CALL(MKFURN,LEVEL2,[-1])
CALL(CMCNSP,LEVEL2,LEVEL1,[-1]) ;FOR FISSION MATCHS.
CALL(KLFURN,LEVEL2)
POP2J
DECLARE{LEVEL1,LEVEL2}
BEND CMCNLL; BGB 4 MAY 1973 ---------------------------------------------------
SUBR(CMCNPP)L1,L2 ;I. COMPARE & CONNECT POLYGONS POLYGONS.
BEGIN CMCNPP;------------------------------------------------------------------
COMMENT ⊗
Compare all the unmated polygons of one levels with their exact match
polygons of another level. Argument L1 is level previous time, argument L2 is
level current time. ⊗
LAC 1,ARG2↔SON 1,1↔DAC 1,P10↔JUMPE 1,POP2J.
LAC 2,ARG1↔SON 2,2↔DAC 2,P20↔JUMPE 2,POP2J.
L1: DAC 2,P2
NTIME 0,2↔JUMPN L4 ;PAST MATED JUMP.
ALT 0,2↔DAC S2
L2: DAC 1,P1
PTIME 0,1↔JUMPN L3 ;FUTURE MATED JUMP.
ALT 0,1↔DAC S1
;COMPARE AND CONNECT ON A MATCH.
CALL(CMPARE,S1,S2)↔JUMPE 1,L3
CALL(CNNECT,S1,S2)↔GO L4
;NO MATCH - CONTINUE SEARCH.
L3: LAC 1,P1↔CCW 1,1 ;ADVANCE LEVEL1'S POLYGON.
CAME 1,P10↔GO L2
;MATCH FOUND OR SEARCH EXHAUSTED.
L4: LAC 1,P10
LAC 2,P2↔CCW 2,2 ;ADVANCE LEVEL2'S POLYGON.
CAME 2,P20↔GO L1
POP2J
DECLARE{P1,P2,P10,P20,S1,S2}
BEND CMCNPP; BGB 4 MAY 1973 ---------------------------------------------------
SUBR(CMCNSP)SL,PL,FLG ;I. COMPARE & CONNECT SHAPES POLYGONS.
BEGIN CMCNSP;------------------------------------------------------------------
COMMENT ⊗ Compare the fusion shapes of one level with the unmated
polygon shapes of another level. ⊗
LAC 1,ARG3↔ALT 1,1↔DAC 1,S0↔JUMPE 1,POP3J. ;1ST SHAPE.
LAC 2,ARG2↔SON 2,2↔DAC 2,P0↔JUMPE 2,POP3J. ;1ST POLYGON.
L1: DAC 1,S1
L2: DAC 2,P2
SKIPE ARG1↔PTIME 0,2 ;FUTURE MATED JUMP.
SKIPN ARG1↔NTIME 0,2↔JUMPN 0,L3 ;PAST MATED JUMP.
ALT 0,2↔DAC S2 ;FETCH THE SHAPE OF P2.
;CALL THE COMPARE AND CONNECT FOR TWO SHAPES.
SKIPE ARG1↔GO L5
CALL(CMPARE,S1,S2)↔JUMPE 1,L3
CALL(CNNECT,S1,S2)↔GO L4
L5: CALL(CMPARE,S2,S1)↔JUMPE 1,L3
CALL(CNNECT,S2,S1)↔GO L4
;ADVANCE IN EACH OF THE RINGS.
L3: LAC 2,P2↔CCW 2,2 ;ADVANCE A POLYGON.
CAME 2,P0↔GO L2
L4: LAC 2,P0
LAC 1,S1↔CCW 1,1 ;ADVANCE A SHAPE.
CAME 1,S0↔GO L1
POP3J
DECLARE{S0,S1,S2,P0,P2}
BEND CMCNSP; BGB 4 MAY 1973----------------------------------------------------
SUBR(MKSHAP)LEVEL ;II. MAKE PGN SHAPE NODES FOR A LEVEL.
BEGIN MKSHAP;------------------------------------------------------------------
;FOR ALL THE POLYGONS OF THIS LEVEL.
LAC 1,ARG1
SON 1,1↔DAC 1,PGN0 ;FIRST POLYGON OF THIS LEVEL.
SKIPN 1↔POP1J ;LEVEL AIN'T GOT NO POLYGON.
ALT 2,1↔JUMPE 2,L1 ;LEVEL'S POLYGONS ALREADY GOT SHAPE.
TESTZ 2,SBIT↔POP1J
L1: DAC 1,PGN1
CALL(MKLINT,PGN1)
LAC 1,PGN1↔CCW 1,1 ;ADVANCE TO NEXT POLYGON
CAME 1,PGN0↔GO L1
POP1J
DECLARE{PGN0,PGN1}
BEND MKSHAP;-------------------------------------------------------------------
SUBR(MKLINT)PGN ;MAKE LAMINA INERTIA TENSOR OF A POLYGON.
BEGIN MKLINT;------------------------------------------------------------------
ACCUMULATORS{DR,DC,A,X,Y,MX,MY,PR,R1,C1,R2,C2,V2}
LAC 1,ARG1↔DZM 6(1) ;CLEAR SHIT LEFT BY INTREE NESTING.
SON V2,1↔DAC V2,V0 ;FIRST VECTOR OF THIS POLYGON.
;CLEAR POLYGON TOTALS.
LAC[XWD P0,P0+1]↔DZM P0↔BLT PXY0
COL C2,V2↔FLO C2,↔ROW R2,V2↔FLO R2, ;FIRST VERTEX LOCUS.
L2: CCW V2,V2↔LAC C1,C2↔LAC R1,R2 ;ADVANCE A VERTEX.
COL C2,V2↔FLO C2,↔ROW R2,V2↔FLO R2, ;NEXT VERTEX LOCUS.
;DELTA ROW & DELTA COLUMN.
LAC DC,C2↔FSBR DC,C1 ;DC ← C2-C1.
LAC DR,R2↔FSBR DR,R1 ;DR ← R2-R1.
CALL(TRI)↔CALL(ACC) ;ACCUMULATE TRIANGULAR PART.
CALL(REC)↔CALL(ACC) ;ACCUMULATE RECTANGULAR PART.
FMPR DC,DC↔FMPR DR,DR ;VECTOR'S LENGTH.
FADR DC,DR↔CALL(SQRT,DC)↔FADRM 1,P0 ;ACCUMULATE PERIMETER.
DZM 6(V2)↔CAME V2,V0↔GO L2 ;CLEAR SHIT LEFT BY INTREE NESTING.
;MAKE AND STUFF A POLYGON SHAPE NODE.
L3: CALL(MKNODE,[SBIT+SHPREL])
LAC[XWD A0,A]↔BLT PR ;FETCH TOTALS TO ACCUMULATORS.
FDVR X,A↔FDVR Y,A ;X ← X0/A0. Y ← Y0/A0.
LAC Y↔FMPR↔FMPR A↔FSBR MX, ;MXX ← MXX0 - Y*Y*A.
LAC X↔FMPR↔FMPR A↔FSBR MY, ;MYY ← MYY0 - X*X*A.
LAC X↔FMPR Y↔FMPR A↔FADR PR, ;PXY ← PXY0 + X*Y*A.
;STUFF DATA INTO THE SHAPE NODE.
LAC P0↔PERM. 0,1↔AREA. A,1 ;PERIMETER & AREA.
FIX X,225000↔COL. X,1 ;CENTER OF MASS.
FIX Y,225000↔ROW. Y,1
PXY. PR,1↔MXX. MX,1↔MYY. MY,1 ;LAMINA INERTIA TENSOR.
FADR MX,MY↔MZZ. MX,1
LAC 2,ARG1↔ALT. 1,2↔PGON. 2,1 ;PARENTAL POLYGON.
POP1J
;........................................................
;ACCUMULATE PORTIONS.
ACC: FADRM A,A0 ;A0 ← A0 + A.
DAC X,0↔FMPR X,A↔FADRM X,X0 ;X0 ← X0 + X*A.
DAC Y,1↔FMPR Y,A↔FADRM Y,Y0 ;Y0 ← Y0 + Y*A.
FMPR X,0↔FADR MY,X↔FADRM MY,MYY0 ;MYY0 ← MYY0 + MY + X*X*A.
FMPR Y,1↔FADR MX,Y↔FADRM MX,MXX0 ;MXX0 ← MXX0 + MX + Y*Y*A.
FMPR 0,1↔FMPR 0,A
FSBR PR,0↔FADRM PR,PXY0 ↔POP0J ;PXY0 ← PXY0 + PR - X*Y*A.
;........................................................
;TRIANGULAR PORTION.
TRI: LAC A,DC↔FMPR A,DR↔FSC A,-1 ;A ← DC*DR/2
LAC X,C2↔FSC X,1↔FADR X,C1↔FDVRI X,(3.0) ;X ← (2*C2 + C1)/3
LAC Y,R1↔FSC Y,1↔FADR Y,R2↔FDVRI Y,(3.0) ;Y ← (2*R1 + R2)/3
LAC DR↔FMPR↔FMPR A↔FDVRI(18.0)↔DAC MX ;MX ← A*DR*DR/18.
LAC DC↔FMPR↔FMPR A↔FDVRI(18.0)↔DAC MY ;MY ← A*DC*DC/18
MOVN A↔FMPR A↔FDVRI(18.0)↔DAC PR↔POP0J ;PR ← -A*A/18.
;........................................................
;RECTANGULAR PORTION.
REC: LAC A,DC↔FMPR A,R1 ;A ← DC*R1
LAC X,C1↔FADR X,C2↔FSC X,-1 ;X ← (C1+C2)/2
LAC Y,R1↔FSC Y,-1 ;Y ← R1/2
LAC MX,R1↔FMPR MX,MX
FMPR MX,A↔FDVRI MX,(12.0) ;MX ← A*R1*R1/12
LAC MY,DC↔FMPR MY,MY
FMPR MY,A↔FDVRI MY,(12.0) ;MY ← A*DC*DC/12
SETZ PR,↔POP0J
DECLARE{V0,P0,A0,X0,Y0,MXX0,MYY0,PXY0}
BEND MKLINT; BGB 4 MAY 1973 ---------------------------------------------------
SUBR(FUSION)S1,S2 ;II. MAKE A FUSION SHAPE NODE.
BEGIN FUSION;-----------------------------------------------------
ACCUMULATORS{S1,S2,A0,A1,A2,MX,MY,DR1,DC1,DR2,DC2,R0,C0}
CALL(MKNODE,[SBIT+SHPREL])
LAC S1,ARG2↔PGON 0,S1↔PGON. 0,1
LAC S2,ARG1↔PGON 0,S2↔NGON. 0,1
PERM A1,S1↔PERM A2,S2↔FADR A1,A2↔PERM. A1,1 ;TOTAL PERIMETER.
AREA A1,S1↔AREA A2,S2
LAC A0,A1↔FADR A0,A2↔AREA. A0,1 ;TOTAL AREA.
;FETCH AND FLOAT CENTERS OF MASS OF SHAPES S1 AND S2.
ROW DR1,S1↔FLO DR1,
COL DC1,S1↔FLO DC1,
ROW DR2,S2↔FLO DR2,
COL DC2,S2↔FLO DC2,
;ROW OF COMBINED CENTERS OF MASS.
LAC 0,DR1↔FMPR 0,A1
LAC R0,DR2↔FMPR R0,A2
FADR R0,0↔FDVR R0,A0
LAC R0↔FIX 225000↔ROW. 0,1
;COL OF COMBINED CENTERS OF MASS.
LAC 0,DC1↔FMPR 0,A1
LAC C0,DC2↔FMPR C0,A2
FADR C0,0↔FDVR C0,A0
LAC C0↔FIX 225000↔COL. 0,1
;DELTA ROW AND DELTA COLUMN.
FSBR DR1,R0↔FSBR DC1,C0
FSBR DR2,R0↔FSBR DC2,C0
;MOMENT ABOUT X.
MXX MX,S1↔MXX 0,S2↔FADRM MX
LAC DR1↔FMPR↔FMPR A1↔FADRM MX
LAC DR2↔FMPR↔FMPR A2↔FADRM MX
MXX. MX,1
;MOMENT ABOUT Y AXIS.
MYY MY,S1↔MYY 0,S2↔FADRM MY
LAC DC1↔FMPR↔FMPR A1↔FADRM MY
LAC DC2↔FMPR↔FMPR A2↔FADRM MY
MYY. MY,1
;MOMENT ABOUT Z AXIS.
FADR MX,MY↔MZZ. MX,1
;PRODUCT OF INERTIA XY.
PXY MX,S1↔PXY 0,S2↔FADRM MX
MOVN DR1↔FMPR DC1↔FMPR A1↔FADRM MX
MOVN DR2↔FMPR DC2↔FMPR A2↔FADRM MX
PXY. MX,1↔POP2J
BEND FUSION; BGB 4 MAY 1973 --------------------------------------
SUBR(MKFURN)LEVEL,FLG ;II. MAKE FUSION RING OF A LEVEL.
BEGIN MKFURN;-----------------------------------------------------
LAC 1,ARG2↔SON 1,1
DAC 1,P0↔JUMPE 1,POP2J. ;FIRST POLYGON.
CW 0,1↔DAC PN ;LAST POLYGON.
L1: DAC 1,P1
SKIPE ARG1↔NTIME 0,1 ;P1'S VIRGINITY TEST.
SKIPN ARG1↔PTIME 0,1↔JUMPN 0,L4
CCW 2,1↔CAMN 2,P0↔POP2J
L2: DAC 2,P2
SKIPE ARG1↔NTIME 0,2 ;P2'S VIRGINITY TEST.
SKIPN ARG1↔PTIME 0,2↔JUMPN 0,L3
;MAKE FUSION SHAPE FOR UNMATED PAIRS OF POLYGONS.
ALT 1,1↔ALT 2,2↔CALL(FUSION,1,2)
LAC 2,ARG2↔ALT 3,2
JUMPE 3,[ALT. 1,2↔CW. 1,1↔CCW. 1,1↔GO L5]↔CW 2,3
CW. 2,1↔CCW. 1,2
CCW. 3,1↔CW. 1,3
L5: LAC 1,P1↔LAC 2,P2
L3: CCW 2,2↔CAME 2,P0↔GO L2 ;ADVANCE P2.
L4: CCW 1,1↔CAME 1,PN↔GO L1 ;ADVANCE P1.
POP2J
DECLARE{P0,P1,P2,PN}
BEND MKFURN; BGB 4 MAY 1973 --------------------------------------
SUBR(KLFURN)LEVEL,FLG ;II. KILL FUSION RING OF A LEVEL.
BEGIN KLFURN;-----------------------------------------------------
LAC 2,ARG1 ;LEVEL.
ALT 1,2↔DAC 1,S0 ;FIRST SHAPE.
JUMPE 1,POP1J.
SETZ↔ALT. 0,2 ;CLEAR FURN POINTER OF LEVEL.
L1: CCW 2,1↔DAC 2,S1 ;NEXT SHAPE.
CALL(KLNODE,1) ;KILL THIS SHPAE.
LAC 1,S1
CAME 1,S0↔GO L1
POP1J
DECLARE{S0,S1}
BEND KLFURN; BGB 4 MAY 1973 --------------------------------------
SUBR(CMPARE)S1,S2 ;III. COMPARE SHAPE SHAPE PASS FAIL.
BEGIN CMPARE;------------------------------------------------------------------
COMMENT ⊗ Compare returns the Boolean value of:
(QQCNTR=0 or QQCNT↑2 ≥ (R1-R2)↑2 + (C1-C2)↑2)
and (QQPRAX=0 or QQPRAX ≥ abs(PRAX1-PRAX2))
and (QQMZZ=0 or QQMZZ ≥ abs(MZZ1-MZZ)/(MZZ1+MZZ2))
and (QQAREA=0 or QQAREA ≥ abs(AREA1-AREA2)/(AREA1+AREA2))
and (QQPERM=0 or QQPERM ≥ abs(PERM1-PERM2)/(PERM1+PERM2)). ⊗
ACCUMULATORS{S1,S2,QQ,Q1,Q2,Q}
LAC S1,ARG2↔LAC S2,ARG1
;CRITERION 1; DISTANCE BETWEEN CENTERS OF MASS.
L1: SKIPN QQ,QQCNTR↔GO L2
ROW 0,S1↔ROW 1,S2↔SUB 0,1↔DAC ROWDEL↔IMUL 0,0↔DAC 0,Q
COL 0,S1↔COL 1,S2↔SUB 0,1↔DAC COLDEL↔IMUL 0,0↔ADD Q,0
FSC Q,217↔FMPR QQ,QQ
SETZ 1,↔CAMLE Q,QQ↔POP2J ;EXIT FALSE.
;CRITERION 2; DIFFERENCE IN ORIENTATIONS OF PRINCIPLE AXES.
L2:
;CRITERION 3; PER CENT DIFFERENCE IN MOMENTS OF INERTIA ABOUT Z
L3: MZZ Q1,S1↔DAC Q1,Q↔MZZ Q2,S2
FSBR Q1,Q2↔MOVMS Q1
FADR Q2,Q↔FDVR Q1,Q2↔SETZ 1,
CAMLE Q1,QQMZZ↔POP2J ;EXIT FALSE
SETO 1,↔POP2J ;EXIT TRUE.
BEND CMPARE; BGB 4 MAY 1973 ---------------------------------------------------
SUBR(CNNECT)S1,S2 III. CONNECT SHAPE SHAPE.
BEGIN CNNECT;------------------------------------------------------------------
ACCUMULATORS{N1,P1,N2,P2,S1,S2,U1,U2,V1,V2}
LAC S1,ARG2↔LAC S2,ARG1
NGON N1,S1↔NGON N2,S2
PGON P1,S1↔PGON P2,S2
PTIME. P2,P1↔NTIME. P1,P2
JUMPN N1,CASE2
JUMPN N2,CASE3
CASE1: MARK P1,PEXCT↔MARK P2,PEXCT ;EXACT P1 ↔ P2.
CALL(CMCNVV,P1,P2)↔POP2J
CASE2: PTIME. P2,N1 ;FUSION N1 & P1 ↔ P2.
MARK N1,PFUSE
MARK P1,PFUSE
MARK P2,NFISS
SON V1,N1↔CW V2,V1 ;SPLICE N1 & P1.
SON U1,P1↔CW U2,U1
CCW. U1,V2↔CW. V2,U1
CCW. V1,U2↔CW. U2,V1
PUSH P,N1↔PUSH P,P1
CALL(CMCNVV,P1,P2) ;CONNECT VERTICES.
POP P,P1↔POP P,N1
SON V1,N1↔CW U2,V1 ;UNSPLICE N1 & P1.
SON U1,P1↔CW V2,U1
CCW. V1,V2↔CW. V2,V1
CCW. U1,U2↔CW. U2,U1↔POP2J
CASE3: NTIME. P1,N2 ;FISSION P1 ↔ N2 & P2.
MARK P1,PFISS
MARK N2,NFUSE
MARK P2,NFUSE
SON V1,N2↔CW V2,V1 ;SPLICE N2 & P2.
SON U1,P2↔CW U2,U1
CCW. U1,V2↔CW. V2,U1
CCW. V1,U2↔CW. U2,V1
PUSH P,N2↔PUSH P,P2
CALL(CMCNVV,P1,P2) ;CONNECT VERTICES.
POP P,P2↔POP P,N2
SON V1,N2↔CW U2,V1 ;UNSPLICE N2 & V2.
SON U1,P2↔CW V2,U1
CCW. V1,V2↔CW. V2,V1
CCW. U1,U2↔CW. U2,U1↔POP2J
BEND CNNECT; BGB 4 MAY 1973 ---------------------------------------------------
SUBR(CMCNVV)P1,P2 ;IV. COMPARE AND CONNECT VERTICES.
BEGIN CMCNVV;------------------------------------------------------------------
COMMENT ⊗ Connect the corresponding vertices of two polygons,
namely those vertices that are within an epsilon of each other and
are mutually closest, that is each is the other's closest neighbor.⊗
;ALLIGN CENTERS OF MASS.
LAC 1,ARG1 ;PICKUP POLYGON #2.
SON 1,1↔DAC 1,2 ;FIRST VERTEX.
ROW 0,1↔ADD 0,ROWDEL↔ROW. 0,1
COL 0,1↔ADD 0,COLDEL↔COL. 0,1
CCW 1,1↔CAME 1,2↔GO .-8
;DIAGONOSTIC DISPLAY.
EXTERN SKY,DPYGON
ACCUMULATORS{W,PGN,V,V0,PTR}
CALL(DPYSET,DPYBUF)
CALL(DPYGON,ARG1)
CALL(DPYGON,ARG2)
CALL(DPYOUT,[5])
L0: JFCL
;PUSH THE FIRST WINDOW.
MOVEI W,TVBUF↑↔DAC W,WINDOW#
DZM LINK(W)↔DZM FLAG(W) ;LINK TO PREVIOUS WINDOW.
DZM RMIN(W)↔MOVEI =216⊗6↔DAC RMAX(W)
DZM CMIN(W)↔MOVEI =288⊗6↔DAC CMAX(W)
LAC PGN,ARG2↔MOVEI PTR,N(W)
SETZ↔SON V,PGN↔DAC V,V0↔PTIME. 0,V
PUSH PTR,V↔CCW V,V↔CAME V,V0↔GO .-4
HLRZM PTR,M(W)↔HRRZS PTR
LAC PGN,ARG1
SETZ↔SON V,PGN↔DAC V,V0↔NTIME. 0,V
PUSH PTR,V↔CCW V,V↔CAME V,V0↔GO .-3
HLRZM PTR,N(W)
;TEST THE WINDOW.
L2: LAC W,WINDOW
SKIPN 1,M(W)↔GO L5
SKIPN 2,N(W)↔GO L5
IMUL 1,2↔CAIG 1,=25↔GO L4
LAC W,WINDOW
LAC RMAX(W)↔SUB RMIN(W)↔MOVMS↔CAIGE 600↔GO L4
LAC CMAX(W)↔SUB CMIN(W)↔MOVMS↔CAIGE 600↔GO L4
L3: SETQ WINDOW,{SPLIT,WINDOW} ;SPLIT THE WINDOW.
GO L2
;SOLVE.
L4: CALL(MATE1,WINDOW) ;SOLVE THE WINDOW.
L5: LAC W,WINDOW ;POP THE WINDOW.
SKIPE W,LINK(W)↔GO[
DAC W,WINDOW↔GO L2]
;"UN" - ALLIGN CENTERS OF MASS.
LAC 1,ARG1 ;PICKUP POLYGON #2.
SON 1,1↔DAC 1,2 ;FIRST VERTEX.
ROW 0,1↔SUB 0,ROWDEL↔ROW. 0,1
COL 0,1↔SUB 0,COLDEL↔COL. 0,1
CCW 1,1↔CAME 1,2↔GO .-8↔POP2J
BEND CMCNVV; BGB 14 APRIL 1973 ___________________________________
SUBR(SPLIT)WINDOW IV. WINDOW SPLIT.
BEGIN SPLIT;______________________________________________________
ACCUMULATORS{U,V,LO,HI,PTR1,PTR2,LOCUT,HICUT,W1,W2}
;GLOBALS{EPSILN,RMATE}
;TEMPORARY WINDOW DIAGONOSTIC.
CALL(DPYSET,DPYBUF)↔LAC 1,ARG1
LAC RMIN(1)↔SUBI =108⊗6↔FLO↔MOVNM YL#
LAC RMAX(1)↔SUBI =108⊗6↔FLO↔MOVNM YH#
LAC CMIN(1)↔SUBI =144⊗6↔FLO↔DAC XL#
LAC CMAX(1)↔SUBI =144⊗6↔FLO↔DAC XH#
CALL(AI,XL,YL)
CALL(AV,XH,YL)
CALL(AV,XH,YH)
CALL(AV,XL,YH)
CALL(AV,XL,YL)
LAC 16,ARG1↔MOVEI 15,N+1(16) ;FIRST VERTEX IN WINDOW.
MOVN M(16)↔DIP 15 ;FIRST POLYGON'S VERTICES.
L01: CALL(GETXY,{(15)})
POP P,2↔POP P,1↔FMPR 1,[3.5]↔FMPR 2,[3.5]↔FIXX 1,↔FIXX 2,
CALL(AIVECT,1,2)↔CALL(DTYO,["1"])
AOBJN 15,L01
MOVN N(16)↔DIP 15 ;SECOND POLYGON'S VERTICES.
L02: CALL(GETXY,{(15)})
POP P,2↔POP P,1↔FMPR 1,[3.5]↔FMPR 2,[3.5]↔FIXX 1,↔FIXX 2,
CALL(AIVECT,1,2)↔CALL(DTYO,["2"])
AOBJN 15,L02
CALL(DPYOUT,[14])
L0:
;SETUP POINTERS AND HEADER'S FOR HI AND LO WINDOW BLOCKS.
LAC W1,ARG1↔MOVEI PTR1,N+1(W1)↔MOVN M(W1)
SUB N(W1)↔DIP PTR1↔MOVNM V
MOVEI W2,N+1(W1)↔ADD W2,V ;HI WINDOW.
;SETUP NEW WINDOW HEADER.
MOVSI RMIN(W1)↔HRRI RMIN(W2)↔BLT CMAX(W2)
SETCM FLAG(W1)↔DAC FLAG(W2)
DAC W1,LINK(W2)
;YE OLDE INSTRUCTION MODIFICATION.
MOVEI(<CAR>)↔SKIPE FLAG(W1)↔MOVEI(<CDR>)
LSH -9
DPB[POINT 9,L2SUBR+1,8]
;MIDPOINT SPLIT THE WINDOW.
SKIPE FLAG(W1)↔GO[
LAC 1,CMAX(W1)↔ADD 1,CMIN(W1)↔ASH 1,-1
DAC 1,CMAX(W1)↔DAC 1,CMIN(W2)↔GO L1]
LAC 1,RMAX(W1)↔ADD 1,RMIN(W1)↔ASH 1,-1
DAC 1,RMAX(W1)↔DAC 1,RMIN(W2)
;ADJUST WINDOW LIMITS TO ALLOW AN OVERLAP.
L1: LAC LOCUT,1↔ADD LOCUT,EPSILN
LAC HICUT,1↔SUB HICUT,EPSILN
L2: MOVEI PTR1,N+1(W1)
LAC PTR2,PTR1
ADD PTR2,M(W1)
MOVN M(W1)↔DIP PTR1
MOVN N(W1)↔DIP PTR2
MOVEI LO,N(W1) ;LO WINDOW VERTICES.
MOVEI HI,N(W2) ;HI WINDOW VERTICES.
CALL(L2SUBR)
HLRZM LO,M(W1)↔HRRZS LO
HLRZM HI,M(W2)↔HRRZS HI
LAC PTR1,PTR2
CALL(L2SUBR)
HLRZM LO,N(W1)
HLRZM HI,N(W2)
LAC 1,W2↔POP1J ;RETURN NEW WINDOW.
L2SUBR: CDR U,(PTR1)↔ROW 0,U
CAMGE 0,LOCUT↔PUSH LO,U
CAMLE 0,HICUT↔PUSH HI,U
AOBJN PTR1,L2SUBR↔POP0J
BEND SPLIT; BGB 14 APRIL 1973 ____________________________________
SUBR(MATE1)WINDOW IV. MATE VERTICES IN WINDOW.
BEGIN MATE1;______________________________________________________
ACCUMULATORS{P1,P2,U,V}
LAC 1,ARG1
MOVEI P1,N+1(1)↔MOVN 0,M(1)↔DIP 0,P1↔DAC P1,PTR1#
CDR P2,P1↔ADD P2,M(1)↔MOVN 0,N(1)↔DIP 0,P2↔DAC P2,PTR2#
CALL(MATE2,PTR1,PTR2)
CALL(MATE2,PTR2,PTR1)
LAC P1,PTR1
L1: CAR P2,(P1)↔JUMPE P2,L2
CAR 0,(P2)↔CAIE 0,(P1)↔GO L2
CDR U,(P1)↔CDR V,(P2)
PTIME 0,U↔NTIME 1,V
IOR 0,1↔JUMPN 0,L2
PTIME. V,U↔NTIME. U,V
L2: AOBJN P1,L1↔POP1J
BEND MATE1; BGB 15 APRIL 1973 ____________________________________
SUBR(MATE2)PTR1,PTR2 IV. FIND VERTEX MATES PTR1 PTR2.
BEGIN MATE2;______________________________________________________
COMMENT⊗ Arguments are expected to be AOBJN accumulators -M,,U1 and -N,,V1 of
the two sets of vertices of a window. In this window, for all the vertices of
the first polygon find the closest vertex of the second polygon. If the closest
vertex is within an epsilon, a pointer to the window block position of the
second polygon's vertex is DIP'ed into the window block position of the first
polygon's vertex.⊗
ACCUMULATORS{PTR1,PTR2,U,V,R,C,R1,C1,RMINIM,VMIN}
;GLOBALS{EPSLN2}
;FOR ALL VERTICES U OF PTR1.
LAC PTR1,ARG2
L1: LAC U,(PTR1)↔ROW R1,U↔COL C1,U
LAC RMINIM,EPSLN2↔DZM VMIN
;FOR ALL VERTICES V OF PTR2.
LAC PTR2,ARG1
L2: LAC V,(PTR2)
;IS THE DISTANCE BETWEEN U AND V LESS THAN R MINIMUM.
ROW R,V↔SUB R,R1↔IMUL R,R
COL C,V↔SUB C,C1↔IMUL C,C↔ADD R,C
CAML R,RMINIM↔GO .+3
DAC R,RMINIM↔HRRZM PTR2,VMIN
AOBJN PTR2,L2
;SAVE POINTER OF VERTEX V OF CLOSEST APPROACH TO VERTEX U.
DIP VMIN,(PTR1)
AOBJN PTR1,L1
POP2J
BEND MATE2; BGB 15 APRIL 1973 ____________________________________
SUBR(SQRT)X TRIG: SQUARE ROOT. AC-TRANSPARENT.
BEGIN SQRT;-------------------------------------------------------
A←←0 ↔ B←←1 ↔ C←←2
MOVM B,ARG1↔JUMPE B,L2
PUSH P,A↔PUSH P,C
;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
ASHC B,-=27↔SUBI B,201 ;PUT EXPONENT IN B, FRACTION IN C.
ROT B,-1 ;CUT EXP IN HALF, SAVE ODD BIT.
DAP B,L1↔LSH B,-=35 ;USE THAT ODD BIT.
ASH C,-10↔FSC C,177(B) ;0.25 < FRACTION < 1.00
;LINEAR APPROXIMATION TO SQRT(F).
DAC C,A
FMP C,[0.8125↔0.578125](B)
FAD C,[0.302734↔0.421875](B)
;TWO ITERATIONS OF NEWTON'S METHOD.
LAC B,A
FDV B,C↔FAD C,B↔FSC C,-1
FDV A,C↔FADR A,C
L1: FSC A,0↔LAC 1,A
POP P,C↔POP P,A
L2: SUB P,[2(2)]↔GO@2(P)
BEND SQRT; BGB 28 DECEMBER 1972 __________________________________
;SUBRS: SINCOS TRIG: SINE AND COSINE ROUTINES.
INTERN SIN,COS;---------------------------------------------------
BEGIN SINCOS
A←1 ↔ B←2 ↔ C←3
↑COS: SKIPA A,ARG1
↑SIN: SKIPA A,ARG1
FADR A,HALFPI ;COS(X) = SIN(X+π/2).
MOVM B,A↔CAMG B,[17B5]↔POP1J ;FOR SMALL X, SIN(X)=X.
;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
FDVR B,HALFPI
LAC C,B↔FIX C,233000
CAILE C,3↔GO[
TRZ C,3↔FSC C,233
FSBR B,C↔GO .-3] ;MODULO 2π.
GO .+1(C)↔GO .+4↔JFCL↔GO[
FSBRI B,(2.0)↔MOVNS B↔GO .+2] ;SIN(X+π)=SIN(-X)
FSBRI B,(4.0) ;SIN(X+2π)=SIN(X)
SKIPGE A↔MOVNS B ;SIN(-X) = -SIN(X).
;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
DAC B,C↔FMPR B,B
LAC A,[164475536722]↔FMP A,B
FAD A,[606315546346]↔FMP A,B
FAD A,[175506321276]↔FMP A,B
FAD A,[577265210372]↔FMP A,B
FAD A,HALFPI↔FMPR A,C↔POP1J
HALFPI: 201622077325 ;PI/2
LIT
BEND SINCOS; BGB 26 APRIL 1973 ___________________________________
SUBR(ATAN2)YYY,XXX TRIG: ARC TANGENT ROUTINE.
BEGIN ATAN2;------------------------------------------------------
;OMEGA ← ATAN2(Y,X).
Y←←1 ↔ X←←2
MOVM Y,ARG2↔MOVM X,ARG1
CAML Y,X↔GO L1
;HORIZONTAL TO π/2; ABS(Y) < ABS(X).
LAC Y,ARG2↔FDVR Y,ARG1
PUSH 17,Y↔PUSHJ 17,ATAN ;ARCTAN(Y/X)
SKIPL ARG1↔POP2J ;1ST & 2ND QUADRANTS.
JUMPGE Y,[
FSBR Y,PI↔POP2J] ;3RD QUADRANT.
FADR Y,PI↔POP2J ;2ND QUADRANT.
;VERTICAL TO π/2; ABS(X) < ABS(Y).
L1: MOVN X,ARG1↔FDVR X,ARG2
PUSH 17,X↔PUSHJ 17,ATAN ;ARCTAN(X/Y)
SKIPG ARG2↔GO[
FSB Y,HALFPI↔POP2J]
FADR Y,HALFPI
POP2J
BEND ATAN2; BGB 26 APRIL 1973 ____________________________________
HALFPI: 201622077325 ;PI/2
PI: 202622077325 ;PI
TWOPI: 203622077325 ;2*PI
SUBR(ACOS)X TRIG: ARC COSINE, ARC SINE ROUTINES.
;ACOS(X)= π/2 - ASIN(X).
;GIVEN -1 ≤ X ≤ +1 RETURN 0 ≤ ACOS(X) ≤ +π.
PUSH 17,ARG1↔PUSHJ 17,ASIN
MOVNS 1↔FADR 1,HALFPI↔POP1J
;-----------------------------------------------------------------
SUBR(ASIN)--------------------------------------------------------
BEGIN ASIN
;ASIN(X)=ATAN(X/SQRT(1-X↑2)).
;GIVEN -1 ≤ X ≤ +1 RETURN -π/2 ≤ ASIN(X) ≤ +π/2.
A←1 ↔ B←2
MOVN A,ARG1↔FMPR A,ARG1↔FADRI A,(1.0)
JUMPE A,[ ;WAS X EITHER -1.0 OR 1.0?
LAC A,HALFPI
SKIPGE ARG1
MOVNS A↔POP1J]
PUSH 17,A↔PUSHJ 17,SQRT
LAC B,ARG1↔FDVR B,1↔DAC B,ARG1 ;CALCULATE X/SQRT(1-X↑2)
GO ATAN ;CALCULATE ATAN(SQRT(1-X↑2))
BEND ASIN; BGB 26 APRIL 1973 _____________________________________
SUBR(ATAN)X TRIG: ARC TANGENT ROUTINE.
BEGIN ATAN;-----------------------------------------------------
;ATAN(X) = X*(B0+A1 / (Z+B1-A2 / (Z+B2-A3 / (Z+B3))) )
;WHERE Z=X↑2, IF 0<X<=1
;IF X>1, THEN ATAN(X) = PI/2 - ATAN(1/X)
;IF X>1, THEN RH(D) =-1, AND LH(D) = -SGN(X)
;IF X<1, THEN RH(D) = 0, AND LH(D) = SGN(X)
A←←1 ↔ B←←2 ↔ C←←3 ↔ D←←4 ↔ E←←5
LAC A,ARG1 ;PICK UP THE ARGUMENT IN A
ATAN1: MOVM B, A ;GET ABSF OF ARGUMENT
CAMG B, A1 ;IF X<2↑-33, THEN RETURN WITH...
POP1J ;ATAN(X) = X
HLLO D, A ;SAVE SIGN, SET RH(D) = -1
CAML B, A2 ;IF A>2↑33, THEN RETURN WITH
GO[LAC A,HALFPI ↔POP1J]; ATAN(X) = PI/2
MOVSI C, 201400 ;FORM 1.0 IN C
CAMG B, C ;IS ABSF(X)>1.0?
TRZA D, -1 ;IF B ≤ 1.0, THEN RH(D) = 0
FDVM C, B ;B IS REPLACED BY 1.0/B
TLC D, (D) ;XOR SIGN WITH > 1.0 INDICATOR
DAC B,E↔FMP B,B
LAC C,B↔FAD C,KB3↔LAC A,KA3↔FDVM A,C
FAD C,B↔FAD C,KB2↔LAC A,KA2↔FDVM A,C
FAD C,B↔FAD C,KB1↔LAC A,KA1↔FDV A,C
FAD A,KB0↔FMP A,E
TRNE D, -1 ;CHECK > 1.0 INDICATOR
FSB A, HALFPI ;ATAN(A) = -(ATAN(1/A)-PI/2)
SKIPGE D ;LH(D) = -SGN(B) IF B>1.0
MOVNS A ;NEGATE ANSWER
POP1J ;EXIT
A1: 145000000000 ;2↑-33
A2: 233000000000 ;2↑33
KB0: 176545543401 ;0.1746554388
KB1: 203660615617 ;6.762139240
KB2: 202650373270 ;3.316335425
KB3: 201562663021 ;1.448631538
KA1: 202732621643 ;3.709256262
KA2: 574071125540 ;-7.106760045
KA3: 600360700773 ;-0.2647686202
BEND ATAN; BGB 26 APRIL 1973 -------------------------------------
END